home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / OTPOLY.ZIP / polygon.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-08-07  |  3.9 KB  |  145 lines
  1. {
  2.    A polygon routine by Outlaw Triad. This procedure needs to be optimized
  3.    quite a bit. Try to implement fixed point math to remove the real type
  4.    values. Also, you could try to implement clipping. Use assembler to gain
  5.    speed. Read "polygon.doc" for additional info on these routines.
  6.  
  7.    The sorting routine in this program divers from the one described in the
  8.    documentation file. Shouldn't be too hard to understand, though...
  9.  
  10.    Code by Vulture/Outlaw Triad
  11. }
  12.  
  13. Program Triangle_Filler;
  14.  
  15. Uses Crt;
  16.  
  17. Const Vga = $0a000;             { Vga segment }
  18.  
  19. Procedure VideoMode(Mode: Byte); Assembler;
  20. Asm
  21.     xor     ah,ah
  22.     mov     al,Mode             { Load vgamode }
  23.     int     10h
  24. End;
  25.  
  26. Procedure WaitRetrace; Assembler;
  27. Asm
  28.     mov     dx,3dah
  29. @Vrt:
  30.     in      al,dx
  31.     test    al,1000b
  32.     jnz     @Vrt
  33. @NoVrt:
  34.     in      al,dx
  35.     test    al,1000b
  36.     jz      @NoVrt
  37. End;
  38.  
  39. Procedure Hline(x1,x2,y:Word;Color:Byte;Where:Word); Assembler;
  40. Asm
  41.     mov   ax,Where
  42.     mov   es,ax
  43.     mov   ax,y                  { Calculate exact vga position }
  44.     mov   di,ax
  45.     shl   ax,8
  46.     shl   di,6
  47.     add   di,ax
  48.     add   di,x1
  49.  
  50.     mov   al,Color              { Set color }
  51.     mov   ah,al
  52.     mov   cx,x2
  53.     sub   cx,x1
  54.     shr   cx,1
  55.     jnc   @Start_Fill
  56.     stosb                       { Plot extra pixel (odd # pixels) }
  57. @Start_Fill:
  58.     rep   stosw                 { Plot all remaining pixels (even # pixels) }
  59. End;
  60.  
  61. Procedure Triangle_Fill(x1,y1,x2,y2,x3,y3: Integer; Color: Byte);
  62. Var Temp, Loop1: Integer;
  63.     StartX, EndX,
  64.     LeftX, RightX: Real;
  65. Begin
  66.  
  67.   { Sort on y-values }
  68.  
  69.   If y1 > y3 then                  { y3 must be the largest y-value }
  70.   Begin
  71.     Temp := y3;
  72.     y3 := y1;
  73.     y1 := Temp;
  74.     Temp := x3;
  75.     x3 := x1;
  76.     x1 := Temp;
  77.   End;
  78.   If y1 > y2 then                  { y1 must be the smallest y-value }
  79.   Begin
  80.     Temp := y2;
  81.     y2 := y1;
  82.     y1 := Temp;
  83.     Temp := x2;
  84.     x2 := x1;
  85.     x1 := Temp;
  86.   End;
  87.   If y2 > y3 then                  { y2 must be the middle value }
  88.   Begin
  89.     Temp := y2;
  90.     y2 := y3;
  91.     y3 := Temp;
  92.     Temp := x2;
  93.     x2 := x3;
  94.     x3 := Temp;
  95.   End;
  96.  
  97.   If (y3-y1) <> 0 then LeftX :=  (x3-x1) / (y3-y1) else LeftX := 0;
  98.   If (y2-y1) <> 0 then RightX := (x2-x1) / (y2-y1) else RightX := 0;
  99.  
  100.   StartX := x1;
  101.   If (y1-y2) <> 0 then EndX := StartX else EndX := x2;
  102.   For Loop1 := y1 to y2 Do         { Draw first half of triangle }
  103.   Begin
  104.     If StartX < EndX then
  105.       Hline(Round(StartX), Round(EndX), Loop1, Color, Vga)
  106.     Else
  107.       Hline(Round(EndX), Round(StartX), Loop1, Color, Vga);
  108.     StartX := StartX + RightX;
  109.     EndX := EndX + LeftX;
  110.   End;
  111.  
  112.   If (y3-y2) <> 0 then RightX := (x3-x2) / (y3-y2) else RightX := 0;
  113.  
  114.   Startx := x2;
  115.   For Loop1 := y2+1 to y3 Do       { Draw second half of triangle }
  116.   Begin
  117.     If StartX < EndX then
  118.       Hline(Round(StartX), Round(EndX), Loop1, Color, Vga)
  119.     Else
  120.       Hline(Round(EndX), Round(StartX), Loop1, Color, Vga);
  121.     StartX := StartX + RightX;
  122.     EndX := EndX + LeftX;
  123.   End;
  124. End;
  125.  
  126. Begin
  127.   Randomize;
  128.   VideoMode($13);
  129.   Repeat
  130.     Triangle_Fill(Random(320),Random(200),Random(320),Random(200),Random(320),Random(200),Random(255));
  131.   Until Keypressed;
  132.   VideoMode($3);
  133.   Writeln('▄  ▄▄  ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄  ▄▄  ▄');
  134.   Writeln('                    - An Outlaw Triad Production (c) 1996 -');
  135.   Writeln;
  136.   Writeln('                             Code∙∙∙∙∙∙∙∙∙∙Vulture');
  137.   Writeln('                             Text∙∙∙∙∙∙∙∙∙∙Inopia');
  138.   Writeln;
  139.   Writeln('                            -=≡ Outlaw Triad Is ≡=-');
  140.   Writeln;
  141.   Writeln('  Vulture/code ■ Archangle/artist ■ Troop/sysop ■ Xplorer/artist ■ Inopia/code');
  142.   Writeln;
  143.   Writeln('▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄');
  144. End.
  145.